home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1256 / tour021.co_ / tour021.co
Text File  |  1997-04-18  |  15KB  |  421 lines
  1.       *---Created with EasyCODE(COB)----------------------------------- # EASY O
  2.       *---Last modification: 01.03.1995 14:24:15----------------------- # EASY K
  3.       *This program is used for presenting a complete offer of all jour\
  4.       *neys available.
  5.       *---------------------------------------------------------------- # EASY *
  6.       *---------------------------------------------------------------- # EASY (
  7.       *TOUR021
  8.       *---------------------------------------------------------------- # EASY *
  9.        IDENTIFICATION DIVISION.
  10.        PROGRAM-ID. TOUR021.
  11.       *
  12.       *
  13.       *        THIS PROGRAM IS USED FOR PRESENTING A COMPLETE OFFER
  14.       *        OF ALL JOURNEYS AVAILABLE.
  15.       *        ITS TAC : OFFER.
  16.       *
  17.       *
  18.        ENVIRONMENT DIVISION.
  19.        DATA DIVISION.
  20.       *---------------------------------------------------------------- # EASY (
  21.       *** Data Division ***
  22.       *---------------------------------------------------------------- # EASY *
  23.        WORKING-STORAGE SECTION.
  24.       *   CONSTANT DEFINITIONS
  25.       
  26.        77 ERRORMESSAGE-1       PIC X(80) VALUE
  27.        "NO MORE JOURNEYS AVAILABLE".
  28.        77 ERRORMESSAGE-2       PIC X(80) VALUE
  29.        "JOURNEY DOES NOT EXIST".
  30.        77 ERRORMESSAGE-3       PIC X(80) VALUE
  31.        "WRONG KEY - ONLY DUE, F1 OR K1 ALLOWED".
  32.       
  33.        COPY KCOPC.
  34.        COPY KCDFC.
  35.       *                                 # EASY S
  36.        LINKAGE SECTION.
  37.       *  VARIABLE DECLARATIONS
  38.      COPY KCKBC.
  39.         05 MENU-MESSAGE   PIC X(80).
  40.         05 EOF          PIC 9.
  41.       
  42.         05 NB          PIC X(404).
  43.         05 INTERNAL-MESSAGE REDEFINES NB.
  44.            COPY INTMESS.
  45.            41 FILLER      PIC X(300).
  46.         05 OFFER        REDEFINES NB.
  47.           COPY OFFER.
  48.       
  49.       
  50.      COPY KCPAC.
  51.       
  52.         03 ERROR-LINE.
  53.            05 RET-CODE PIC X(3).
  54.            05 OCCURRED-AT       PIC X(5).
  55.            05 OP-CODE  PIC X(4).
  56.       
  57.         03 JOURNEY.
  58.            COPY JOURNEY.
  59.       
  60.       
  61.         03 PEND-MODE      PIC X(2).
  62.         03 NEXT-TAC      PIC X(8).
  63.         03 ERROR-SIGN      PIC 9.
  64.         03 IND          PIC 9(2).
  65.       *                                 # EASY S
  66.       *---------------------------------------------------------------- # EASY )
  67.        PROCEDURE DIVISION USING KCKBC KCSPAB.
  68.       *---------------------------------------------------------------- # EASY (
  69.       *** Procedure Division ***
  70.       *---------------------------------------------------------------- # EASY *
  71.        MAIN SECTION.
  72.        MAIN.
  73.        PERFORM
  74.       *  UTM-INITIALIZATION
  75.        INIT-OPERATION
  76.        IF
  77.       *    CURRENT FORMAT = OFFER
  78.        KCRMF = "*OFFER"
  79.        THEN
  80.           PERFORM GO-ON-OFFERING
  81.        ELSE
  82.           PERFORM START-OFFERING
  83.        END-IF
  84.        PERFORM PEND-OPERATION
  85.        EXIT PROGRAM
  86.        .
  87.       *                                 # EASY P
  88.       *                                 # EASY S
  89.       *---------------------------------------------------------------- # EASY (
  90.       **** SUBROUTINE Section ***
  91.       *---------------------------------------------------------------- # EASY *
  92.        SUBROUTINE SECTION.
  93.       *---------------------------------------------------------------- # EASY (
  94.       **** GO-ON-OFFERING ***
  95.       *---------------------------------------------------------------- # EASY *
  96.        GO-ON-OFFERING.
  97.        PERFORM MGET-OPERATION
  98.        EVALUATE
  99.       *    RETURNCODE
  100.        KCRCCC
  101.        WHEN
  102.       *    DUE-KEY
  103.        "000"
  104.           PERFORM GO-ON-SCROLLING
  105.        WHEN
  106.       *    F1-KEY
  107.        "21Z"
  108.           PERFORM BOOK
  109.        WHEN
  110.       *    K1-KEY
  111.        "24Z"
  112.           PERFORM END-OF-OFFER
  113.        WHEN OTHER
  114.           IF
  115.       *    WRONG KEY
  116.           KCRCCC NOT < F1-KEY AND
  117.           KCRCCC NOT > K2-KEY
  118.           THEN
  119.          PERFORM REJECT-WRONG-KEY
  120.           ELSE
  121.          PERFORM ERROR-MPUT-OPERATION,
  122.          PERFORM ERROR-PEND-OPERATION
  123.           END-IF
  124.        END-EVALUATE
  125.        .
  126.       *                                 # EASY P
  127.       *---------------------------------------------------------------- # EASY )
  128.       *---------------------------------------------------------------- # EASY (
  129.       **** START-OFFERING ***
  130.       *---------------------------------------------------------------- # EASY *
  131.        START-OFFERING.
  132.        PERFORM INTERNAL-MGET
  133.       *                                 # EASY -
  134.       *    INITIALIZE OFFER FORMAT
  135.        MOVE SPACES TO OFFER
  136.        MOVE ZEROES TO JOURNEY-ID OF JOURNEY,
  137.        BOOKING-JOURNEY-ID OF OFFER
  138.        PERFORM FILL-JOURNEY-TABLE
  139.        PERFORM PREPARE-OUTPUT
  140.        PERFORM MPUT-OPERATION
  141.        .
  142.       *                                 # EASY P
  143.       *---------------------------------------------------------------- # EASY )
  144.       *---------------------------------------------------------------- # EASY (
  145.       **** GO-ON-SCROLLING ***
  146.       *---------------------------------------------------------------- # EASY *
  147.        GO-ON-SCROLLING.
  148.       *    DELETE OFFER-TABLE
  149.        MOVE SPACES TO JOURNEY-TABLE-TAB OF OFFER
  150.        IF
  151.       *    MORE JOURNEYS AVAILABLE
  152.        EOF = 0
  153.        THEN
  154.           MOVE ZERO TO IND
  155.           PERFORM WITH TEST BEFORE UNTIL
  156.       *    MAXIMUM OF 10 TABLE ENTRIES
  157.           IND = 10 OR
  158.           EOF NOT = 0
  159.          PERFORM READ-JOURNEY
  160.           END-PERFORM
  161.        ELSE
  162.           MOVE ZERO TO JOURNEY-ID OF JOURNEY,
  163.           PERFORM FILL-JOURNEY-TABLE
  164.        END-IF
  165.        PERFORM PREPARE-OUTPUT
  166.        PERFORM MPUT-OPERATION
  167.        .
  168.       *                                 # EASY P
  169.       *---------------------------------------------------------------- # EASY )
  170.       *---------------------------------------------------------------- # EASY (
  171.       **** END-OF-OFFER ***
  172.       *---------------------------------------------------------------- # EASY *
  173.        END-OF-OFFER.
  174.       *    BACK TO MENU-OUTPUT
  175.        MOVE SPACES TO MENU-MESSAGE
  176.        MOVE "MENUOUT" TO NEXT-TAC
  177.        MOVE "PR" TO PEND-MODE
  178.        .
  179.       *                                 # EASY P
  180.       *---------------------------------------------------------------- # EASY )
  181.       *---------------------------------------------------------------- # EASY (
  182.       **** BOOK ***
  183.       *---------------------------------------------------------------- # EASY *
  184.        BOOK.
  185.        PERFORM
  186.        SECOND-MGET-OPERATION
  187.       *    REQUESTED BY UTM
  188.       *                                 # EASY -
  189.       *    TAKE JOURNEY-ID OF JOURNEY TO BE BOOKED FROM OFFER-MASK
  190.        MOVE BOOKING-JOURNEY-ID OF OFFER TO
  191.        JOURNEY-ID OF JOURNEY, JOURNEY-ID OF INTERNAL-MESSAGE
  192.        CALL "RDJRNEY" USING JOURNEY, ERROR-SIGN
  193.        IF
  194.       *    SUCCESSFUL
  195.        ERROR-SIGN = 0
  196.        THEN
  197.       *    TAKE WHERE-TO-GO
  198.           MOVE WHERE-TO-GO OF JOURNEY TO
  199.           WHERE-TO-GO OF INTERNAL-MESSAGE,
  200.           MOVE SPACES TO MESSAGE-TEXT OF INTERNAL-MESSAGE
  201.        ELSE
  202.       *    JOURNEY DOES NOT EXIST
  203.           MOVE SPACES TO WHERE-TO-GO OF INTERNAL-MESSAGE,
  204.           MOVE ERRORMESSAGE-2 TO MESSAGE-TEXT OF INTERNAL-MESSAGE
  205.        END-IF
  206.       *    HANDLE UTM-FIELDS
  207.        MOVE 104 TO KCLM
  208.        MOVE "OFFBOOK" TO KCRN, NEXT-TAC
  209.        MOVE "FC" TO PEND-MODE
  210.        PERFORM MPUT-OPERATION
  211.        .
  212.       *                                 # EASY P
  213.       *---------------------------------------------------------------- # EASY )
  214.       *---------------------------------------------------------------- # EASY (
  215.       **** REJECT-WRONG-KEY ***
  216.       *---------------------------------------------------------------- # EASY *
  217.        REJECT-WRONG-KEY.
  218.        PERFORM FILL-JOURNEY-TABLE
  219.       *                                 # EASY -
  220.       *    WRONG KEY - ONLY DUE, F1 OR K1 ALLOWED
  221.        MOVE ERRORMESSAGE-3 TO MESSAGE-TEXT OF OFFER
  222.        PERFORM PREPARE-OUTPUT
  223.        PERFORM MPUT-OPERATION
  224.        .
  225.       *                                 # EASY P
  226.       *---------------------------------------------------------------- # EASY )
  227.       *---------------------------------------------------------------- # EASY (
  228.       **** FILL-JOURNEY-TABLE ***
  229.       *---------------------------------------------------------------- # EASY *
  230.        FILL-JOURNEY-TABLE.
  231.        CALL "POSJRNEY" USING JOURNEY, ERROR-SIGN
  232.        IF
  233.       *    SUCCESSFUL
  234.        ERROR-SIGN = 0
  235.        THEN
  236.       *    INITIALIZE TABLE-INDEX AND END-OF-FILE SIGN
  237.           MOVE ZERO TO IND, EOF
  238.           PERFORM WITH TEST BEFORE UNTIL
  239.       *    MAXIMUM 10 TIMES
  240.           IND = 10 OR
  241.           EOF NOT = 0
  242.          PERFORM READ-JOURNEY
  243.           END-PERFORM
  244.        ELSE
  245.       *    NO MORE JOURNEYS AVAILABLE
  246.           MOVE ERRORMESSAGE-1 TO MESSAGE-TEXT OF OFFER
  247.        END-IF
  248.        .
  249.       *                                 # EASY P
  250.       *---------------------------------------------------------------- # EASY )
  251.       *---------------------------------------------------------------- # EASY (
  252.       **** READ-JOURNEY ***
  253.       *---------------------------------------------------------------- # EASY *
  254.        READ-JOURNEY.
  255.       *    NEXT TABLE-INDEX
  256.        ADD 1 TO IND
  257.        CALL "NXTJRNEY" USING JOURNEY-TABLE OF OFFER(IND), EOF
  258.        IF
  259.       *    UNSUCCESSFUL
  260.        EOF NOT = 0
  261.        THEN
  262.       *    NO MORE JOURNEYS AVAILABLE
  263.           MOVE ERRORMESSAGE-1 TO MESSAGE-TEXT OF OFFER
  264.       *                                 # EASY -
  265.       *    UPDATE TABLE-INDEX
  266.           SUBTRACT 1 FROM IND
  267.        END-IF
  268.        .
  269.       *                                 # EASY P
  270.       *---------------------------------------------------------------- # EASY )
  271.       *---------------------------------------------------------------- # EASY (
  272.       **** PREPARE-OUTPUT ***
  273.       *---------------------------------------------------------------- # EASY *
  274.        PREPARE-OUTPUT.
  275.       *    CREATE OFFER-MASK
  276.        MOVE 404 TO KCLM
  277.        MOVE "*OFFER" TO KCMF
  278.        MOVE SPACES TO KCRN
  279.        MOVE "OFFER" TO NEXT-TAC
  280.        MOVE "RE" TO PEND-MODE
  281.        MOVE KCREPL TO KCDF
  282.        .
  283.       *                                 # EASY P
  284.       *---------------------------------------------------------------- # EASY )
  285.       *                                 # EASY S
  286.       *---------------------------------------------------------------- # EASY )
  287.       *---------------------------------------------------------------- # EASY (
  288.       **** KDCS Section ***
  289.       *---------------------------------------------------------------- # EASY *
  290.        KDCS SECTION.
  291.       *---------------------------------------------------------------- # EASY (
  292.       **** INIT-OPERATION ***
  293.       *---------------------------------------------------------------- # EASY *
  294.        INIT-OPERATION.
  295.        MOVE INIT TO KCOP
  296.       *                                 # EASY -
  297.        MOVE 485 TO KCLKBPRG
  298.       *                                 # EASY -
  299.        MOVE 1000 TO KCLPAB
  300.        CALL "KDCS" USING KCPAC
  301.        IF KCRCCC NOT = "000"
  302.        THEN
  303.           PERFORM ERROR-MPUT-OPERATION
  304.           PERFORM ERROR-PEND-OPERATION
  305.        END-IF
  306.        .
  307.       *                                 # EASY P
  308.       *---------------------------------------------------------------- # EASY )
  309.       *---------------------------------------------------------------- # EASY (
  310.       **** MGET-OPERATION ***
  311.       *---------------------------------------------------------------- # EASY *
  312.        MGET-OPERATION.
  313.        MOVE MGET TO KCOP
  314.       *                                 # EASY -
  315.        MOVE 404 TO KCLA
  316.       *                                 # EASY -
  317.        MOVE "*OFFER" TO KCMF
  318.        CALL "KDCS" USING KCPAC, OFFER
  319.        .
  320.       *                                 # EASY P
  321.       *---------------------------------------------------------------- # EASY )
  322.       *---------------------------------------------------------------- # EASY (
  323.       **** SECOND-MGET-OPERATION ***
  324.       *---------------------------------------------------------------- # EASY *
  325.        SECOND-MGET-OPERATION.
  326.        MOVE MGET TO KCOP
  327.       *                                 # EASY -
  328.        MOVE "*OFFER" TO KCMF
  329.       *                                 # EASY -
  330.        MOVE 404 TO KCLA
  331.        CALL "KDCS" USING KCPAC, OFFER
  332.        IF KCRCCC NOT = "000"
  333.        THEN
  334.           PERFORM ERROR-MPUT-OPERATION,
  335.           PERFORM ERROR-PEND-OPERATION
  336.        END-IF
  337.        .
  338.       *                                 # EASY P
  339.       *---------------------------------------------------------------- # EASY )
  340.       *---------------------------------------------------------------- # EASY (
  341.       **** INTERNAL-MGET ***
  342.       *---------------------------------------------------------------- # EASY *
  343.        INTERNAL-MGET.
  344.        MOVE MGET TO KCOP
  345.       *                                 # EASY -
  346.        MOVE 0 TO KCLA
  347.       *                                 # EASY -
  348.        MOVE SPACES TO KCMF
  349.        CALL "KDCS" USING KCPAC, INTERNAL-MESSAGE
  350.        .
  351.       *                                 # EASY P
  352.       *---------------------------------------------------------------- # EASY )
  353.       *---------------------------------------------------------------- # EASY (
  354.       **** MPUT-OPERATION ***
  355.       *---------------------------------------------------------------- # EASY *
  356.        MPUT-OPERATION.
  357.        MOVE MPUT TO KCOP
  358.       *                                 # EASY -
  359.        MOVE "NE" TO KCOM
  360.        CALL "KDCS" USING KCPAC, NB
  361.        IF KCRCCC > "000"
  362.        THEN
  363.           PERFORM ERROR-PEND-OPERATION
  364.        END-IF
  365.        .
  366.       *                                 # EASY P
  367.       *---------------------------------------------------------------- # EASY )
  368.       *---------------------------------------------------------------- # EASY (
  369.       **** PEND-OPERATION ***
  370.       *---------------------------------------------------------------- # EASY *
  371.        PEND-OPERATION.
  372.        MOVE LOW-VALUES TO KCPAC
  373.       *                                 # EASY -
  374.        MOVE PEND TO KCOP
  375.       *                                 # EASY -
  376.        MOVE PEND-MODE TO KCOM
  377.       *                                 # EASY -
  378.        MOVE NEXT-TAC TO KCRN
  379.        CALL "KDCS" USING KCPAC
  380.        .
  381.       *                                 # EASY P
  382.       *---------------------------------------------------------------- # EASY )
  383.       *---------------------------------------------------------------- # EASY (
  384.       **** ERROR-PEND-OPERATION ***
  385.       *---------------------------------------------------------------- # EASY *
  386.        ERROR-PEND-OPERATION.
  387.        MOVE PEND TO KCOP
  388.       *                                 # EASY -
  389.        MOVE "ER" TO KCOM
  390.        CALL "KDCS" USING KCPAC
  391.        .
  392.       *                                 # EASY P
  393.       *---------------------------------------------------------------- # EASY )
  394.       *---------------------------------------------------------------- # EASY (
  395.       **** ERROR-MPUT-OPERATION ***
  396.       *---------------------------------------------------------------- # EASY *
  397.        ERROR-MPUT-OPERATION.
  398.        MOVE KCRCCC TO RET-CODE
  399.       *                                 # EASY -
  400.        MOVE " AT " TO OCCURRED-AT
  401.       *                                 # EASY -
  402.        MOVE KCOP TO OP-CODE
  403.       *                                 # EASY -
  404.        MOVE MPUT TO KCOP
  405.       *                                 # EASY -
  406.        MOVE "NE" TO KCOM,
  407.        MOVE  20  TO KCLM
  408.       *                                 # EASY -
  409.        MOVE SPACES TO KCMF, KCRN
  410.       *                                 # EASY -
  411.        MOVE KCALARM TO KCDF
  412.        CALL "KDCS" USING KCPAC, ERROR-LINE
  413.        .
  414.       *                                 # EASY P
  415.       *---------------------------------------------------------------- # EASY )
  416.       *                                 # EASY S
  417.       *---------------------------------------------------------------- # EASY )
  418.       *---------------------------------------------------------------- # EASY )
  419.        END PROGRAM TOUR021.
  420.       *---------------------------------------------------------------- # EASY )
  421.